1 Workspace

1.1 Packages

pkg <- c("knitr", "lme4", "psych", "EGAnet", "tidymodels", "vip", "qgraph", "RColorBrewer", "lubridate", "broom", "broom.mixed", "plyr", "tidyverse")
if(any(!pkg %in% rownames(installed.packages()))){
  pkg <- pkg[!pkg %in% rownames(installed.packages())]
  lapply(pkg, install.packages)
}

library(knitr)         # rmarkdown
library(lme4)          # estimate mlms
## Loading required package: Matrix
library(psych)         # psychometrics, descriptives, structural models, and more
library(EGAnet)        # exploratory graph analysis
## 
## EGAnet (version 1.1.0) 
## For help getting started, type browseVignettes("EGAnet")
##  
## For bugs and errors, submit an issue to <https://github.com/hfgolino/EGAnet/issues>
library(RColorBrewer)
library(vip)
## 
## Attaching package: 'vip'
## The following object is masked from 'package:utils':
## 
##     vi
library(qgraph)
library(lubridate)
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
library(broom)
library(broom.mixed)
library(plyr)          # data wrangling
library(tidyverse)     # data wrangling, cleaning, and more
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ ggplot2::%+%()           masks psych::%+%()
## ✖ ggplot2::alpha()         masks psych::alpha()
## ✖ dplyr::arrange()         masks plyr::arrange()
## ✖ lubridate::as.difftime() masks base::as.difftime()
## ✖ purrr::compact()         masks plyr::compact()
## ✖ dplyr::count()           masks plyr::count()
## ✖ lubridate::date()        masks base::date()
## ✖ tidyr::expand()          masks Matrix::expand()
## ✖ dplyr::failwith()        masks plyr::failwith()
## ✖ dplyr::filter()          masks stats::filter()
## ✖ dplyr::id()              masks plyr::id()
## ✖ lubridate::intersect()   masks base::intersect()
## ✖ dplyr::lag()             masks stats::lag()
## ✖ dplyr::mutate()          masks plyr::mutate()
## ✖ tidyr::pack()            masks Matrix::pack()
## ✖ dplyr::rename()          masks plyr::rename()
## ✖ lubridate::setdiff()     masks base::setdiff()
## ✖ dplyr::summarise()       masks plyr::summarise()
## ✖ dplyr::summarize()       masks plyr::summarize()
## ✖ lubridate::union()       masks base::union()
## ✖ tidyr::unpack()          masks Matrix::unpack()
library(tidymodels)    # framework for estimating ML and other models
## ── Attaching packages ────────────────────────────────────── tidymodels 0.2.0 ──
## ✔ dials        1.0.0     ✔ rsample      1.0.0
## ✔ infer        1.0.2     ✔ tune         0.2.0
## ✔ modeldata    0.1.1     ✔ workflows    0.2.6
## ✔ parsnip      1.0.0     ✔ workflowsets 0.2.1
## ✔ recipes      0.2.0     ✔ yardstick    1.0.0
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ ggplot2::%+%()     masks psych::%+%()
## ✖ scales::alpha()    masks ggplot2::alpha(), psych::alpha()
## ✖ dplyr::arrange()   masks plyr::arrange()
## ✖ purrr::compact()   masks plyr::compact()
## ✖ dplyr::count()     masks plyr::count()
## ✖ scales::discard()  masks purrr::discard()
## ✖ tidyr::expand()    masks Matrix::expand()
## ✖ dplyr::failwith()  masks plyr::failwith()
## ✖ dplyr::filter()    masks stats::filter()
## ✖ recipes::fixed()   masks stringr::fixed()
## ✖ dplyr::id()        masks plyr::id()
## ✖ dplyr::lag()       masks stats::lag()
## ✖ dplyr::mutate()    masks plyr::mutate()
## ✖ tidyr::pack()      masks Matrix::pack()
## ✖ dplyr::rename()    masks plyr::rename()
## ✖ yardstick::spec()  masks readr::spec()
## ✖ recipes::step()    masks stats::step()
## ✖ dplyr::summarise() masks plyr::summarise()
## ✖ dplyr::summarize() masks plyr::summarize()
## ✖ tidyr::unpack()    masks Matrix::unpack()
## ✖ recipes::update()  masks Matrix::update(), stats::update()
## • Dig deeper into tidy modeling with R at https://www.tmwr.org

1.2 Working Directory

wd <- "https://github.com/emoriebeck"

2 Exercise 1: Working with Dynamic Data

2.1 Load in Data

dat <- read_csv(url(sprintf("%s/ESM-structure/blob/main/02-data/02-facet-wide/02-imputed/02-participant-data/csv/221.csv?raw=true", wd))) %>%
  separate(Full_Date, c("date", "time"), sep = "[ ]") %>%
  mutate(day = as.numeric(mapvalues(date, unique(date), 1:length(unique(date))))) %>%
  group_by(day) %>%
  mutate(beep = 1:n()) %>% 
  ungroup() %>%
  filter(beep <=4)
## Rows: 261 Columns: 17
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (1): Full_Date
## dbl (16): agreeableness_Compassion, agreeableness_Respectfulness, agreeablen...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

2.2 Pad Missing Observations

dat <- dat %>% 
  full_join(
    crossing(
      day = unique(dat$day)
      , beep = 1:6
      )
  ) %>%
  arrange(day, beep)
## Joining, by = c("day", "beep")

2.3 Add Lags

dat <- dat %>%
  mutate_at(vars(-date, -time, -all_beeps, -day, -beep), lst(lag = lag))

# how many rows without lags?
dat %>% 
  select(-contains("lag")) %>%
  drop_na()
# how many rows with lags
dat %>% 
  select(-date, -time, -all_beeps) %>%
  drop_na()

3 Exercise 2: Basic Dynamic Indices

3.1 Intraindividual SD (Within-Person Variability)

sd(dat$agreeableness_Compassion, na.rm = T)
## [1] 1.128466
# the tidy way
dat %>%
  select(-contains("lag"), -date, -time, -all_beeps, -day, -beep) %>%
  summarize_all(sd, na.rm = T) %>%
  pivot_longer(
    cols = everything()
    , names_to = "var"
    , values_to = "sd"
  )
# base R
sapply(
  dat %>%
    select(-contains("lag"), -date, -time, -all_beeps, -day, -beep)
  , function(x) sd(x, na.rm = T)
  )
##         agreeableness_Compassion     agreeableness_Respectfulness 
##                        1.1284663                        0.9935696 
##              agreeableness_Trust   conscientiousness_Organization 
##                        0.9465205                        1.2037256 
## conscientiousness_Productiveness conscientiousness_Responsibility 
##                        1.2332386                        1.2143000 
##       extraversion_Assertiveness        extraversion_Energy.Level 
##                        1.2590248                        1.1948333 
##         extraversion_Sociability              neuroticism_Anxiety 
##                        1.2560469                        0.9712506 
##           neuroticism_Depression neuroticism_Emotional.Volatility 
##                        0.8784962                        1.1528547 
##   openness_Aesthetic.Sensitivity    openness_Creative.Imagination 
##                        1.1051526                        1.0645676 
##  openness_Intellectual.Curiosity 
##                        1.0484114

3.2 Mean Squared Successive Differences (MSSD)

mssd(dat$agreeableness_Compassion)
## [1] 0.8981203
# the tidy way
dat %>%
  select(-contains("lag"), -date, -time, -all_beeps, -day, -beep) %>%
  summarize_all(mssd) %>%
  pivot_longer(
    cols = everything()
    , names_to = "var"
    , values_to = "mssd"
  )
# base R
sapply(
  dat %>%
    select(-contains("lag"), -date, -time, -all_beeps, -day, -beep)
  , mssd
  )
##         agreeableness_Compassion     agreeableness_Respectfulness 
##                        0.8981203                        0.8653933 
##              agreeableness_Trust   conscientiousness_Organization 
##                        0.6080334                        1.6481133 
## conscientiousness_Productiveness conscientiousness_Responsibility 
##                        1.9799844                        1.3155733 
##       extraversion_Assertiveness        extraversion_Energy.Level 
##                        1.1916452                        1.0303352 
##         extraversion_Sociability              neuroticism_Anxiety 
##                        1.5822683                        0.5613855 
##           neuroticism_Depression neuroticism_Emotional.Volatility 
##                        0.5373800                        1.0765382 
##   openness_Aesthetic.Sensitivity    openness_Creative.Imagination 
##                        1.1491743                        1.1249584 
##  openness_Intellectual.Curiosity 
##                        0.6683865

3.3 Inertia (AR(1) autocorrelations)

cor(dat$agreeableness_Compassion, dat$agreeableness_Compassion_lag, use = "pairwise")
## [1] 0.2950876
# the tidy way
dat %>%
  select(-contains("lag")) %>%
  pivot_longer(
    cols = c(-date, -time, -all_beeps, -day, -beep)
    , names_to = "var"
    , values_to = "value"
    ) %>%
  group_by(var) %>%
  summarize(ar1 = cor(value, lag(value), use = "pairwise"))

3.4 Bringing It All Together

dat %>%
  select(-contains("lag")) %>%
  pivot_longer(
    cols = c(-date, -time, -all_beeps, -day, -beep)
    , names_to = "var"
    , values_to = "value"
    ) %>%
  group_by(var) %>%
  summarize(
    sd = sd(value, na.rm = T)
    , mssd = mssd(value)
    , ar1 = cor(value, lag(value), use = "pairwise")
    )

4 Exercise 3: Regularized Regression Using Elastic Net and tidymodels

4.1 Load Data

First, we need to load the data and do some feature engineering

load(url(sprintf("%s/behavior-prediction/blob/main/04-data/02-model-data/216_prcrst_psychological_BFI-2_no%%20time.RData?raw=true", wd)))
d

4.2 Feature Engineering using Time Stamps

dtime <- d %>%
  select(Full_Date) %>%
  mutate(Full_Date = ymd_hm(Full_Date)
         , wkday = wday(Full_Date, label = T)
         , Hour = hour(Full_Date)
         , Mon =     ifelse(wkday == "Mon", 1, 0)
         , Tue =     ifelse(wkday == "Tue", 1, 0)
         , Wed =     ifelse(wkday == "Wed", 1, 0)
         , Thu =     ifelse(wkday == "Thu", 1, 0)
         , Fri =     ifelse(wkday == "Fri", 1, 0)
         , Sat =     ifelse(wkday == "Sat", 1, 0)
         , Sun =     ifelse(wkday == "Sun", 1, 0)
         , morning = ifelse(Hour  >= 5  & Hour < 11, 1, 0)
         , midday =  ifelse(Hour  >= 11 & Hour < 17, 1, 0)
         , evening = ifelse(Hour  >= 5  & Hour < 22, 1, 0)) %>%
  
  ## sequential time differences
  mutate(tdif =      as.numeric(difftime(Full_Date, lag(Full_Date), units = "hours"))) %>%
  filter(is.na(tdif) | tdif > 1) %>%
  mutate(tdif =      as.numeric(difftime(Full_Date, lag(Full_Date), units = "hours"))
         , tdif =    ifelse(is.na(tdif), 0, tdif)
         , cumsumT = cumsum(tdif)) %>%
  
  ## timing variables
  mutate(linear =    as.numeric(scale(cumsumT))
         , quad =    linear^2
         , cub =     linear^3
         , sin1p =   sin(((2*pi)/24)*cumsumT)
         , sin2p =   sin(((2*pi)/12)*cumsumT)
         , cos1p =   cos(((2*pi)/24)*cumsumT)
         , cos2p =   cos(((2*pi)/12)*cumsumT)
         ) %>%
  
  ## keep key variables and reshape
  select(Full_Date, Mon:evening, linear:cos2p)

dummy_vars <- c("o_value", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"
                , "morning", "midday", "evening")

d <- d %>%
  mutate(Full_Date = ymd_hm(Full_Date)) %>%
  full_join(dtime) %>%
  arrange(Full_Date) %>%
  select(-Full_Date) %>%
  mutate_at(vars(dummy_vars), factor) %>%
  filter(complete.cases(.)); d
## Joining, by = "Full_Date"
## Note: Using an external vector in selections is ambiguous. ℹ Use
## `all_of(dummy_vars)` instead of `dummy_vars` to silence this message. ℹ See
## <https://tidyselect.r-lib.org/reference/faq-external-vector.html>. This message
## is displayed once per session.

4.3 Set-Up Data

d_split <- initial_time_split(d, prop = 0.75); d_split
## <Training/Testing/Total>
## <72/25/97>
d_train <- training(d_split); d_train
d_test  <- testing(d_split); d_test

4.4 Set-Up Preprocessing & Recipe in TidyModels

# set up the data and formula
time_vars <- c("cos1p", "cos2p", "cub", "linear", "quad", "sin1p", "sin2p")

mod_recipe <- recipe(
  o_value ~ .
  , data = d_train
  ) %>%
  step_normalize(all_numeric(), -one_of(time_vars)) %>%
  step_dummy(one_of(dummy_vars), -all_outcomes()) %>%
  step_zv(all_numeric()) %>%
  step_nzv(all_nominal(), unique_cut = 35); mod_recipe
## Recipe
## 
## Inputs:
## 
##       role #variables
##    outcome          1
##  predictor         32
## 
## Operations:
## 
## Centering and scaling for all_numeric(), -one_of(time_vars)
## Dummy variables from one_of(dummy_vars), -all_outcomes()
## Zero variance filter on all_numeric()
## Sparse, unbalanced variable filter on all_nominal()
# set up the model specifications 
tune_spec <- 
  logistic_reg(
    penalty = tune()
    , mixture = tune()
  ) %>% 
  set_engine("glmnet") %>% 
  set_mode("classification")

# set up the ranges for the tuning functions 
elnet_grid <- grid_regular(
  penalty()
  , mixture()
  , levels = 10
  )

# set up the workflow: combine modeling spec with modeling recipe
set.seed(345)
elnet_wf <- workflow() %>%
  add_model(tune_spec) %>%
  add_recipe(mod_recipe)

4.5 Run Rolling Origin-Validation

# set up the folds
d_train_cv <- rolling_origin(
    d_train, 
    initial = 15, 
    assess = 3,
    skip = 2,
    cumulative = TRUE
  )

# run our workflow from above across each fold
elnet_res <- 
    elnet_wf %>% 
    tune_grid(
      resamples = d_train_cv
      , grid = elnet_grid
      , control = control_resamples(save_pred = T)
      )

4.6 Choose the Best Model

# plot the metrics across tuning parameters
elnet_res %>%
    collect_metrics() %>%
      ggplot(aes(penalty, mean, color = mixture)) +
      geom_point(size = 2) +
      facet_wrap(~ .metric, scales = "free", nrow = 2) +
      scale_x_log10(labels = scales::label_number()) +
      scale_color_gradient(low = "gray90", high = "red") +
      theme_classic()

# select the best model based on AUC
  best_elnet <- elnet_res %>%
    # select_best("roc_auc")
    select_best("accuracy")
  
  # set up the workflow for the best model
  final_wf <- 
    elnet_wf %>% 
    finalize_workflow(best_elnet)
  
# run the final best model on the training data and save
final_elnet <- 
    final_wf %>%
    fit(data = d_train) 
## Warning in lognet(xd, is.sparse, ix, jx, y, weights, offset, alpha, nobs, : one
## multinomial or binomial class has fewer than 8 observations; dangerous ground

4.7 Run the Model on the Test Set

# run the final fit workflow of the training and test data together
final_fit <- 
    final_wf %>%
    last_fit(d_split) 
## ! train/test split: preprocessor 1/1, model 1/1: one multinomial or binomial class has fewer...
# final metrics (accuracy and roc)
final_metrics <- final_fit %>%
    collect_metrics(summarize = T); final_metrics

4.8 Variable Importance

# variable importance
final_var_imp <- final_elnet %>% 
  pull_workflow_fit() %>% 
  vi() %>%
  slice_max(Importance, n = 10); final_var_imp
## Warning: `pull_workflow_fit()` was deprecated in workflows 0.2.3.
## Please use `extract_fit_parsnip()` instead.

5 Exercise 4: Dynamic Exploratory Graph Analysis

5.1 Data Set-up

set.seed(5) # set a seed for randomly sampling 10 participants
dat4 <- read_csv(url(sprintf("%s/ESM-structure/blob/main/02-data/02-facet-wide/02-imputed/facet_wide_imp.csv?raw=true", wd))) %>%
  filter(complete.cases(.)) %>% # drop missing obs
  group_by(SID) %>%
  filter(n() >= 30) %>% # keep only people with reasonable #'s of obs
  ungroup() %>%
  filter(SID %in% sample(unique(.$SID), 10)) %>% # sample 10 px
  mutate(wave = 1) %>% # create a wave "grouping" variable
  arrange(wave, SID, all_beeps) %>% # reorder the data
  select(-Full_Date, -all_beeps) %>% # drop columns that aren't ID, group, or indicators
  as.data.frame() # this is important! dynEGA won't work on tibbles
## Rows: 23615 Columns: 18
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (2): SID, Full_Date
## dbl (16): agreeableness_Compassion, agreeableness_Respectfulness, agreeablen...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

5.2 Run the Model

# get numeric ID of the participant ID column
idcol <- which(colnames(dat4) == "SID")
gcol  <- which(colnames(dat4) == "wave")

ega_ind <- dynEGA(
  data = dat4 
  , n.embed = 4 # embedding dimension
  , tau = 1  # offset for embedding, similar to lag 1
  , delta = 4 # time between obs
  , level = "individual" # we want individual-level models 
  , id = idcol # id column position
  , group = gcol # group membership, in this case the wave
  , use.derivatives = 1 # we want to use 1st order derivatives
  , model = "glasso" 
  , algorithm = "louvain" # the clustering algorithm for structure
  , corr = "pearson" # type of correlation
  , ncores = 6 # number of cores
); ega_ind
## 
## Computing derivatives using GLLA...
## Estimating the dimensionality structure using EGA...
## Level: Individual (Intraindividual Structure)...
## done
## Number of Cases (individuals): 
## [1] 10
## Summary statistics (number of factors/communities): 
## Mean: 2.5 
## Median: 3 
## Min: 0 
## Max: 4

5.3 Explore the Object

First, let’s look at the derivatives. These are stored as a list for each participant:

# derivatives list
names(ega_ind$Derivatives$Estimates)
##  [1] "ID143" "ID148" "ID162" "ID168" "ID180" "ID186" "ID192" "ID38"  "ID63" 
## [10] "ID78"
# for one px
ega_ind$Derivatives$Estimates$ID143 %>% as_tibble()

Or a large data frame:

ega_ind$Derivatives$EstimatesDF %>% as_tibble()

Now let’s look at the EGA. These are also stored as a list for each participant.

names(ega_ind$dynEGA)
##  [1] "ID143" "ID148" "ID162" "ID168" "ID180" "ID186" "ID192" "ID38"  "ID63" 
## [10] "ID78"
names(ega_ind$dynEGA$ID143)
## [1] "network"       "wc"            "n.dim"         "cor.data"     
## [5] "gamma"         "lambda"        "dim.variables"

Here’s the breakdown:

  • network = regularized partial correlation matrix.
  • wc = cluster membership how igraph produces it
  • n.dim = number of cluster
  • cor.data = zero-order correlations of the derivatives
  • mu = hyperparameter for glasso, 0 means it uses BIC for model selection
  • lambda = regularization shrinkage parameter
  • dim.variables = also cluster membership, but as a data frame
ega_ind$dynEGA$ID143$network
##                                       agreeableness_Compassion.Ord1
## agreeableness_Compassion.Ord1                            0.00000000
## agreeableness_Respectfulness.Ord1                        0.00000000
## agreeableness_Trust.Ord1                                 0.00000000
## conscientiousness_Organization.Ord1                      0.00000000
## conscientiousness_Productiveness.Ord1                    0.00000000
## conscientiousness_Responsibility.Ord1                    0.00000000
## extraversion_Assertiveness.Ord1                          0.00000000
## extraversion_Energy.Level.Ord1                           0.00000000
## extraversion_Sociability.Ord1                            0.00000000
## neuroticism_Anxiety.Ord1                                -0.09646158
## neuroticism_Depression.Ord1                              0.00000000
## neuroticism_Emotional.Volatility.Ord1                   -0.27236328
## openness_Aesthetic.Sensitivity.Ord1                      0.00000000
## openness_Creative.Imagination.Ord1                       0.18753804
## openness_Intellectual.Curiosity.Ord1                     0.00000000
##                                       agreeableness_Respectfulness.Ord1
## agreeableness_Compassion.Ord1                                0.00000000
## agreeableness_Respectfulness.Ord1                            0.00000000
## agreeableness_Trust.Ord1                                     0.04193298
## conscientiousness_Organization.Ord1                          0.00000000
## conscientiousness_Productiveness.Ord1                        0.00000000
## conscientiousness_Responsibility.Ord1                        0.28647794
## extraversion_Assertiveness.Ord1                             -0.07296645
## extraversion_Energy.Level.Ord1                               0.00000000
## extraversion_Sociability.Ord1                                0.00000000
## neuroticism_Anxiety.Ord1                                     0.02076857
## neuroticism_Depression.Ord1                                  0.00000000
## neuroticism_Emotional.Volatility.Ord1                        0.15807089
## openness_Aesthetic.Sensitivity.Ord1                          0.00000000
## openness_Creative.Imagination.Ord1                           0.00000000
## openness_Intellectual.Curiosity.Ord1                         0.19358344
##                                       agreeableness_Trust.Ord1
## agreeableness_Compassion.Ord1                       0.00000000
## agreeableness_Respectfulness.Ord1                   0.04193298
## agreeableness_Trust.Ord1                            0.00000000
## conscientiousness_Organization.Ord1                 0.20654350
## conscientiousness_Productiveness.Ord1               0.00000000
## conscientiousness_Responsibility.Ord1               0.00000000
## extraversion_Assertiveness.Ord1                     0.07619860
## extraversion_Energy.Level.Ord1                      0.03280065
## extraversion_Sociability.Ord1                       0.10078699
## neuroticism_Anxiety.Ord1                            0.00000000
## neuroticism_Depression.Ord1                         0.00000000
## neuroticism_Emotional.Volatility.Ord1               0.00000000
## openness_Aesthetic.Sensitivity.Ord1                 0.23756930
## openness_Creative.Imagination.Ord1                  0.26449228
## openness_Intellectual.Curiosity.Ord1                0.00000000
##                                       conscientiousness_Organization.Ord1
## agreeableness_Compassion.Ord1                                  0.00000000
## agreeableness_Respectfulness.Ord1                              0.00000000
## agreeableness_Trust.Ord1                                       0.20654350
## conscientiousness_Organization.Ord1                            0.00000000
## conscientiousness_Productiveness.Ord1                          0.00000000
## conscientiousness_Responsibility.Ord1                          0.07773032
## extraversion_Assertiveness.Ord1                               -0.03120325
## extraversion_Energy.Level.Ord1                                 0.00000000
## extraversion_Sociability.Ord1                                  0.00000000
## neuroticism_Anxiety.Ord1                                       0.00000000
## neuroticism_Depression.Ord1                                   -0.15393608
## neuroticism_Emotional.Volatility.Ord1                          0.00000000
## openness_Aesthetic.Sensitivity.Ord1                            0.00000000
## openness_Creative.Imagination.Ord1                             0.00000000
## openness_Intellectual.Curiosity.Ord1                           0.00000000
##                                       conscientiousness_Productiveness.Ord1
## agreeableness_Compassion.Ord1                                    0.00000000
## agreeableness_Respectfulness.Ord1                                0.00000000
## agreeableness_Trust.Ord1                                         0.00000000
## conscientiousness_Organization.Ord1                              0.00000000
## conscientiousness_Productiveness.Ord1                            0.00000000
## conscientiousness_Responsibility.Ord1                            0.14513046
## extraversion_Assertiveness.Ord1                                  0.00000000
## extraversion_Energy.Level.Ord1                                   0.00000000
## extraversion_Sociability.Ord1                                    0.00000000
## neuroticism_Anxiety.Ord1                                         0.00000000
## neuroticism_Depression.Ord1                                      0.00000000
## neuroticism_Emotional.Volatility.Ord1                            0.00000000
## openness_Aesthetic.Sensitivity.Ord1                              0.09295943
## openness_Creative.Imagination.Ord1                               0.00000000
## openness_Intellectual.Curiosity.Ord1                             0.00000000
##                                       conscientiousness_Responsibility.Ord1
## agreeableness_Compassion.Ord1                                    0.00000000
## agreeableness_Respectfulness.Ord1                                0.28647794
## agreeableness_Trust.Ord1                                         0.00000000
## conscientiousness_Organization.Ord1                              0.07773032
## conscientiousness_Productiveness.Ord1                            0.14513046
## conscientiousness_Responsibility.Ord1                            0.00000000
## extraversion_Assertiveness.Ord1                                  0.00000000
## extraversion_Energy.Level.Ord1                                   0.00000000
## extraversion_Sociability.Ord1                                   -0.02778201
## neuroticism_Anxiety.Ord1                                         0.00000000
## neuroticism_Depression.Ord1                                     -0.01266155
## neuroticism_Emotional.Volatility.Ord1                            0.00000000
## openness_Aesthetic.Sensitivity.Ord1                              0.18373027
## openness_Creative.Imagination.Ord1                              -0.05590719
## openness_Intellectual.Curiosity.Ord1                             0.40289256
##                                       extraversion_Assertiveness.Ord1
## agreeableness_Compassion.Ord1                              0.00000000
## agreeableness_Respectfulness.Ord1                         -0.07296645
## agreeableness_Trust.Ord1                                   0.07619860
## conscientiousness_Organization.Ord1                       -0.03120325
## conscientiousness_Productiveness.Ord1                      0.00000000
## conscientiousness_Responsibility.Ord1                      0.00000000
## extraversion_Assertiveness.Ord1                            0.00000000
## extraversion_Energy.Level.Ord1                             0.14236089
## extraversion_Sociability.Ord1                              0.00000000
## neuroticism_Anxiety.Ord1                                   0.00000000
## neuroticism_Depression.Ord1                                0.00000000
## neuroticism_Emotional.Volatility.Ord1                     -0.10840522
## openness_Aesthetic.Sensitivity.Ord1                        0.16720137
## openness_Creative.Imagination.Ord1                         0.00000000
## openness_Intellectual.Curiosity.Ord1                       0.00000000
##                                       extraversion_Energy.Level.Ord1
## agreeableness_Compassion.Ord1                             0.00000000
## agreeableness_Respectfulness.Ord1                         0.00000000
## agreeableness_Trust.Ord1                                  0.03280065
## conscientiousness_Organization.Ord1                       0.00000000
## conscientiousness_Productiveness.Ord1                     0.00000000
## conscientiousness_Responsibility.Ord1                     0.00000000
## extraversion_Assertiveness.Ord1                           0.14236089
## extraversion_Energy.Level.Ord1                            0.00000000
## extraversion_Sociability.Ord1                             0.32906737
## neuroticism_Anxiety.Ord1                                  0.00000000
## neuroticism_Depression.Ord1                               0.00000000
## neuroticism_Emotional.Volatility.Ord1                     0.00000000
## openness_Aesthetic.Sensitivity.Ord1                       0.13128565
## openness_Creative.Imagination.Ord1                        0.00000000
## openness_Intellectual.Curiosity.Ord1                      0.00000000
##                                       extraversion_Sociability.Ord1
## agreeableness_Compassion.Ord1                            0.00000000
## agreeableness_Respectfulness.Ord1                        0.00000000
## agreeableness_Trust.Ord1                                 0.10078699
## conscientiousness_Organization.Ord1                      0.00000000
## conscientiousness_Productiveness.Ord1                    0.00000000
## conscientiousness_Responsibility.Ord1                   -0.02778201
## extraversion_Assertiveness.Ord1                          0.00000000
## extraversion_Energy.Level.Ord1                           0.32906737
## extraversion_Sociability.Ord1                            0.00000000
## neuroticism_Anxiety.Ord1                                 0.00000000
## neuroticism_Depression.Ord1                             -0.11916977
## neuroticism_Emotional.Volatility.Ord1                    0.00000000
## openness_Aesthetic.Sensitivity.Ord1                      0.00000000
## openness_Creative.Imagination.Ord1                       0.00000000
## openness_Intellectual.Curiosity.Ord1                     0.00000000
##                                       neuroticism_Anxiety.Ord1
## agreeableness_Compassion.Ord1                      -0.09646158
## agreeableness_Respectfulness.Ord1                   0.02076857
## agreeableness_Trust.Ord1                            0.00000000
## conscientiousness_Organization.Ord1                 0.00000000
## conscientiousness_Productiveness.Ord1               0.00000000
## conscientiousness_Responsibility.Ord1               0.00000000
## extraversion_Assertiveness.Ord1                     0.00000000
## extraversion_Energy.Level.Ord1                      0.00000000
## extraversion_Sociability.Ord1                       0.00000000
## neuroticism_Anxiety.Ord1                            0.00000000
## neuroticism_Depression.Ord1                         0.20650709
## neuroticism_Emotional.Volatility.Ord1               0.04973374
## openness_Aesthetic.Sensitivity.Ord1                 0.00000000
## openness_Creative.Imagination.Ord1                  0.09460686
## openness_Intellectual.Curiosity.Ord1                0.00000000
##                                       neuroticism_Depression.Ord1
## agreeableness_Compassion.Ord1                          0.00000000
## agreeableness_Respectfulness.Ord1                      0.00000000
## agreeableness_Trust.Ord1                               0.00000000
## conscientiousness_Organization.Ord1                   -0.15393608
## conscientiousness_Productiveness.Ord1                  0.00000000
## conscientiousness_Responsibility.Ord1                 -0.01266155
## extraversion_Assertiveness.Ord1                        0.00000000
## extraversion_Energy.Level.Ord1                         0.00000000
## extraversion_Sociability.Ord1                         -0.11916977
## neuroticism_Anxiety.Ord1                               0.20650709
## neuroticism_Depression.Ord1                            0.00000000
## neuroticism_Emotional.Volatility.Ord1                  0.22624339
## openness_Aesthetic.Sensitivity.Ord1                    0.00000000
## openness_Creative.Imagination.Ord1                     0.00000000
## openness_Intellectual.Curiosity.Ord1                   0.00000000
##                                       neuroticism_Emotional.Volatility.Ord1
## agreeableness_Compassion.Ord1                                   -0.27236328
## agreeableness_Respectfulness.Ord1                                0.15807089
## agreeableness_Trust.Ord1                                         0.00000000
## conscientiousness_Organization.Ord1                              0.00000000
## conscientiousness_Productiveness.Ord1                            0.00000000
## conscientiousness_Responsibility.Ord1                            0.00000000
## extraversion_Assertiveness.Ord1                                 -0.10840522
## extraversion_Energy.Level.Ord1                                   0.00000000
## extraversion_Sociability.Ord1                                    0.00000000
## neuroticism_Anxiety.Ord1                                         0.04973374
## neuroticism_Depression.Ord1                                      0.22624339
## neuroticism_Emotional.Volatility.Ord1                            0.00000000
## openness_Aesthetic.Sensitivity.Ord1                             -0.14828005
## openness_Creative.Imagination.Ord1                               0.00000000
## openness_Intellectual.Curiosity.Ord1                             0.00000000
##                                       openness_Aesthetic.Sensitivity.Ord1
## agreeableness_Compassion.Ord1                                  0.00000000
## agreeableness_Respectfulness.Ord1                              0.00000000
## agreeableness_Trust.Ord1                                       0.23756930
## conscientiousness_Organization.Ord1                            0.00000000
## conscientiousness_Productiveness.Ord1                          0.09295943
## conscientiousness_Responsibility.Ord1                          0.18373027
## extraversion_Assertiveness.Ord1                                0.16720137
## extraversion_Energy.Level.Ord1                                 0.13128565
## extraversion_Sociability.Ord1                                  0.00000000
## neuroticism_Anxiety.Ord1                                       0.00000000
## neuroticism_Depression.Ord1                                    0.00000000
## neuroticism_Emotional.Volatility.Ord1                         -0.14828005
## openness_Aesthetic.Sensitivity.Ord1                            0.00000000
## openness_Creative.Imagination.Ord1                             0.00000000
## openness_Intellectual.Curiosity.Ord1                           0.00000000
##                                       openness_Creative.Imagination.Ord1
## agreeableness_Compassion.Ord1                                 0.18753804
## agreeableness_Respectfulness.Ord1                             0.00000000
## agreeableness_Trust.Ord1                                      0.26449228
## conscientiousness_Organization.Ord1                           0.00000000
## conscientiousness_Productiveness.Ord1                         0.00000000
## conscientiousness_Responsibility.Ord1                        -0.05590719
## extraversion_Assertiveness.Ord1                               0.00000000
## extraversion_Energy.Level.Ord1                                0.00000000
## extraversion_Sociability.Ord1                                 0.00000000
## neuroticism_Anxiety.Ord1                                      0.09460686
## neuroticism_Depression.Ord1                                   0.00000000
## neuroticism_Emotional.Volatility.Ord1                         0.00000000
## openness_Aesthetic.Sensitivity.Ord1                           0.00000000
## openness_Creative.Imagination.Ord1                            0.00000000
## openness_Intellectual.Curiosity.Ord1                          0.00000000
##                                       openness_Intellectual.Curiosity.Ord1
## agreeableness_Compassion.Ord1                                    0.0000000
## agreeableness_Respectfulness.Ord1                                0.1935834
## agreeableness_Trust.Ord1                                         0.0000000
## conscientiousness_Organization.Ord1                              0.0000000
## conscientiousness_Productiveness.Ord1                            0.0000000
## conscientiousness_Responsibility.Ord1                            0.4028926
## extraversion_Assertiveness.Ord1                                  0.0000000
## extraversion_Energy.Level.Ord1                                   0.0000000
## extraversion_Sociability.Ord1                                    0.0000000
## neuroticism_Anxiety.Ord1                                         0.0000000
## neuroticism_Depression.Ord1                                      0.0000000
## neuroticism_Emotional.Volatility.Ord1                            0.0000000
## openness_Aesthetic.Sensitivity.Ord1                              0.0000000
## openness_Creative.Imagination.Ord1                               0.0000000
## openness_Intellectual.Curiosity.Ord1                             0.0000000
ega_ind$dynEGA$ID143$wc
##         agreeableness_Compassion.Ord1     agreeableness_Respectfulness.Ord1 
##                                     1                                     2 
##              agreeableness_Trust.Ord1   conscientiousness_Organization.Ord1 
##                                     3                                     1 
## conscientiousness_Productiveness.Ord1 conscientiousness_Responsibility.Ord1 
##                                     2                                     2 
##       extraversion_Assertiveness.Ord1        extraversion_Energy.Level.Ord1 
##                                     3                                     3 
##         extraversion_Sociability.Ord1              neuroticism_Anxiety.Ord1 
##                                     3                                     1 
##           neuroticism_Depression.Ord1 neuroticism_Emotional.Volatility.Ord1 
##                                     1                                     1 
##   openness_Aesthetic.Sensitivity.Ord1    openness_Creative.Imagination.Ord1 
##                                     3                                     3 
##  openness_Intellectual.Curiosity.Ord1 
##                                     2
ega_ind$dynEGA$ID143$n.dim
## [1] 3
ega_ind$dynEGA$ID143$cor.data
##                                       agreeableness_Compassion.Ord1
## agreeableness_Compassion.Ord1                           1.000000000
## agreeableness_Respectfulness.Ord1                      -0.144917198
## agreeableness_Trust.Ord1                                0.175232445
## conscientiousness_Organization.Ord1                     0.008481247
## conscientiousness_Productiveness.Ord1                  -0.090531113
## conscientiousness_Responsibility.Ord1                  -0.046594591
## extraversion_Assertiveness.Ord1                         0.237280217
## extraversion_Energy.Level.Ord1                          0.004410670
## extraversion_Sociability.Ord1                           0.092657858
## neuroticism_Anxiety.Ord1                               -0.294995032
## neuroticism_Depression.Ord1                            -0.187998551
## neuroticism_Emotional.Volatility.Ord1                  -0.487960576
## openness_Aesthetic.Sensitivity.Ord1                    -0.094449559
## openness_Creative.Imagination.Ord1                      0.374580338
## openness_Intellectual.Curiosity.Ord1                    0.097445847
##                                       agreeableness_Respectfulness.Ord1
## agreeableness_Compassion.Ord1                               -0.14491720
## agreeableness_Respectfulness.Ord1                            1.00000000
## agreeableness_Trust.Ord1                                     0.22733578
## conscientiousness_Organization.Ord1                          0.15188072
## conscientiousness_Productiveness.Ord1                        0.11508995
## conscientiousness_Responsibility.Ord1                        0.59763669
## extraversion_Assertiveness.Ord1                             -0.26029253
## extraversion_Energy.Level.Ord1                              -0.14374524
## extraversion_Sociability.Ord1                               -0.01017949
## neuroticism_Anxiety.Ord1                                     0.21949054
## neuroticism_Depression.Ord1                                  0.12950398
## neuroticism_Emotional.Volatility.Ord1                        0.35952234
## openness_Aesthetic.Sensitivity.Ord1                          0.12089388
## openness_Creative.Imagination.Ord1                          -0.17862193
## openness_Intellectual.Curiosity.Ord1                         0.54388484
##                                       agreeableness_Trust.Ord1
## agreeableness_Compassion.Ord1                     0.1752324446
## agreeableness_Respectfulness.Ord1                 0.2273357807
## agreeableness_Trust.Ord1                          1.0000000000
## conscientiousness_Organization.Ord1               0.4129780505
## conscientiousness_Productiveness.Ord1            -0.0003581812
## conscientiousness_Responsibility.Ord1             0.0297829522
## extraversion_Assertiveness.Ord1                   0.3330555363
## extraversion_Energy.Level.Ord1                    0.3247680721
## extraversion_Sociability.Ord1                     0.3357442349
## neuroticism_Anxiety.Ord1                          0.1144625384
## neuroticism_Depression.Ord1                      -0.1850295196
## neuroticism_Emotional.Volatility.Ord1            -0.1172334276
## openness_Aesthetic.Sensitivity.Ord1               0.4898881130
## openness_Creative.Imagination.Ord1                0.4634941426
## openness_Intellectual.Curiosity.Ord1             -0.0180078457
##                                       conscientiousness_Organization.Ord1
## agreeableness_Compassion.Ord1                                 0.008481247
## agreeableness_Respectfulness.Ord1                             0.151880718
## agreeableness_Trust.Ord1                                      0.412978051
## conscientiousness_Organization.Ord1                           1.000000000
## conscientiousness_Productiveness.Ord1                         0.097969594
## conscientiousness_Responsibility.Ord1                         0.290368424
## extraversion_Assertiveness.Ord1                              -0.157668146
## extraversion_Energy.Level.Ord1                                0.063739422
## extraversion_Sociability.Ord1                                 0.115635672
## neuroticism_Anxiety.Ord1                                     -0.045553558
## neuroticism_Depression.Ord1                                  -0.350860934
## neuroticism_Emotional.Volatility.Ord1                        -0.136406952
## openness_Aesthetic.Sensitivity.Ord1                           0.265036100
## openness_Creative.Imagination.Ord1                            0.148653742
## openness_Intellectual.Curiosity.Ord1                          0.015304397
##                                       conscientiousness_Productiveness.Ord1
## agreeableness_Compassion.Ord1                                 -0.0905311127
## agreeableness_Respectfulness.Ord1                              0.1150899451
## agreeableness_Trust.Ord1                                      -0.0003581812
## conscientiousness_Organization.Ord1                            0.0979695937
## conscientiousness_Productiveness.Ord1                          1.0000000000
## conscientiousness_Responsibility.Ord1                          0.3777149131
## extraversion_Assertiveness.Ord1                                0.1723266074
## extraversion_Energy.Level.Ord1                                 0.1092529252
## extraversion_Sociability.Ord1                                  0.0066986477
## neuroticism_Anxiety.Ord1                                       0.0031348955
## neuroticism_Depression.Ord1                                    0.0720746796
## neuroticism_Emotional.Volatility.Ord1                         -0.1159234988
## openness_Aesthetic.Sensitivity.Ord1                            0.3205474808
## openness_Creative.Imagination.Ord1                             0.0283903815
## openness_Intellectual.Curiosity.Ord1                           0.2713788357
##                                       conscientiousness_Responsibility.Ord1
## agreeableness_Compassion.Ord1                                   -0.04659459
## agreeableness_Respectfulness.Ord1                                0.59763669
## agreeableness_Trust.Ord1                                         0.02978295
## conscientiousness_Organization.Ord1                              0.29036842
## conscientiousness_Productiveness.Ord1                            0.37771491
## conscientiousness_Responsibility.Ord1                            1.00000000
## extraversion_Assertiveness.Ord1                                 -0.11824425
## extraversion_Energy.Level.Ord1                                  -0.06751410
## extraversion_Sociability.Ord1                                   -0.18150240
## neuroticism_Anxiety.Ord1                                         0.06733940
## neuroticism_Depression.Ord1                                     -0.19675725
## neuroticism_Emotional.Volatility.Ord1                           -0.08387357
## openness_Aesthetic.Sensitivity.Ord1                              0.41801298
## openness_Creative.Imagination.Ord1                              -0.21722840
## openness_Intellectual.Curiosity.Ord1                             0.68352130
##                                       extraversion_Assertiveness.Ord1
## agreeableness_Compassion.Ord1                              0.23728022
## agreeableness_Respectfulness.Ord1                         -0.26029253
## agreeableness_Trust.Ord1                                   0.33305554
## conscientiousness_Organization.Ord1                       -0.15766815
## conscientiousness_Productiveness.Ord1                      0.17232661
## conscientiousness_Responsibility.Ord1                     -0.11824425
## extraversion_Assertiveness.Ord1                            1.00000000
## extraversion_Energy.Level.Ord1                             0.38047327
## extraversion_Sociability.Ord1                              0.10590085
## neuroticism_Anxiety.Ord1                                   0.01886838
## neuroticism_Depression.Ord1                                0.09439041
## neuroticism_Emotional.Volatility.Ord1                     -0.35793173
## openness_Aesthetic.Sensitivity.Ord1                        0.42602702
## openness_Creative.Imagination.Ord1                         0.18766602
## openness_Intellectual.Curiosity.Ord1                       0.12597299
##                                       extraversion_Energy.Level.Ord1
## agreeableness_Compassion.Ord1                             0.00441067
## agreeableness_Respectfulness.Ord1                        -0.14374524
## agreeableness_Trust.Ord1                                  0.32476807
## conscientiousness_Organization.Ord1                       0.06373942
## conscientiousness_Productiveness.Ord1                     0.10925293
## conscientiousness_Responsibility.Ord1                    -0.06751410
## extraversion_Assertiveness.Ord1                           0.38047327
## extraversion_Energy.Level.Ord1                            1.00000000
## extraversion_Sociability.Ord1                             0.53053567
## neuroticism_Anxiety.Ord1                                  0.01995421
## neuroticism_Depression.Ord1                              -0.02092129
## neuroticism_Emotional.Volatility.Ord1                    -0.17666250
## openness_Aesthetic.Sensitivity.Ord1                       0.38957794
## openness_Creative.Imagination.Ord1                        0.10358889
## openness_Intellectual.Curiosity.Ord1                     -0.00652038
##                                       extraversion_Sociability.Ord1
## agreeableness_Compassion.Ord1                           0.092657858
## agreeableness_Respectfulness.Ord1                      -0.010179487
## agreeableness_Trust.Ord1                                0.335744235
## conscientiousness_Organization.Ord1                     0.115635672
## conscientiousness_Productiveness.Ord1                   0.006698648
## conscientiousness_Responsibility.Ord1                  -0.181502397
## extraversion_Assertiveness.Ord1                         0.105900846
## extraversion_Energy.Level.Ord1                          0.530535673
## extraversion_Sociability.Ord1                           1.000000000
## neuroticism_Anxiety.Ord1                               -0.206975832
## neuroticism_Depression.Ord1                            -0.324131535
## neuroticism_Emotional.Volatility.Ord1                  -0.065618517
## openness_Aesthetic.Sensitivity.Ord1                     0.143488176
## openness_Creative.Imagination.Ord1                      0.147939076
## openness_Intellectual.Curiosity.Ord1                   -0.147868651
##                                       neuroticism_Anxiety.Ord1
## agreeableness_Compassion.Ord1                     -0.294995032
## agreeableness_Respectfulness.Ord1                  0.219490540
## agreeableness_Trust.Ord1                           0.114462538
## conscientiousness_Organization.Ord1               -0.045553558
## conscientiousness_Productiveness.Ord1              0.003134896
## conscientiousness_Responsibility.Ord1              0.067339404
## extraversion_Assertiveness.Ord1                    0.018868378
## extraversion_Energy.Level.Ord1                     0.019954211
## extraversion_Sociability.Ord1                     -0.206975832
## neuroticism_Anxiety.Ord1                           1.000000000
## neuroticism_Depression.Ord1                        0.414310299
## neuroticism_Emotional.Volatility.Ord1              0.316687604
## openness_Aesthetic.Sensitivity.Ord1                0.066432716
## openness_Creative.Imagination.Ord1                 0.242009546
## openness_Intellectual.Curiosity.Ord1               0.148926682
##                                       neuroticism_Depression.Ord1
## agreeableness_Compassion.Ord1                         -0.18799855
## agreeableness_Respectfulness.Ord1                      0.12950398
## agreeableness_Trust.Ord1                              -0.18502952
## conscientiousness_Organization.Ord1                   -0.35086093
## conscientiousness_Productiveness.Ord1                  0.07207468
## conscientiousness_Responsibility.Ord1                 -0.19675725
## extraversion_Assertiveness.Ord1                        0.09439041
## extraversion_Energy.Level.Ord1                        -0.02092129
## extraversion_Sociability.Ord1                         -0.32413153
## neuroticism_Anxiety.Ord1                               0.41431030
## neuroticism_Depression.Ord1                            1.00000000
## neuroticism_Emotional.Volatility.Ord1                  0.45415488
## openness_Aesthetic.Sensitivity.Ord1                   -0.18675038
## openness_Creative.Imagination.Ord1                    -0.06386812
## openness_Intellectual.Curiosity.Ord1                   0.10632541
##                                       neuroticism_Emotional.Volatility.Ord1
## agreeableness_Compassion.Ord1                                   -0.48796058
## agreeableness_Respectfulness.Ord1                                0.35952234
## agreeableness_Trust.Ord1                                        -0.11723343
## conscientiousness_Organization.Ord1                             -0.13640695
## conscientiousness_Productiveness.Ord1                           -0.11592350
## conscientiousness_Responsibility.Ord1                           -0.08387357
## extraversion_Assertiveness.Ord1                                 -0.35793173
## extraversion_Energy.Level.Ord1                                  -0.17666250
## extraversion_Sociability.Ord1                                   -0.06561852
## neuroticism_Anxiety.Ord1                                         0.31668760
## neuroticism_Depression.Ord1                                      0.45415488
## neuroticism_Emotional.Volatility.Ord1                            1.00000000
## openness_Aesthetic.Sensitivity.Ord1                             -0.37696342
## openness_Creative.Imagination.Ord1                              -0.15339317
## openness_Intellectual.Curiosity.Ord1                             0.06495692
##                                       openness_Aesthetic.Sensitivity.Ord1
## agreeableness_Compassion.Ord1                                 -0.09444956
## agreeableness_Respectfulness.Ord1                              0.12089388
## agreeableness_Trust.Ord1                                       0.48988811
## conscientiousness_Organization.Ord1                            0.26503610
## conscientiousness_Productiveness.Ord1                          0.32054748
## conscientiousness_Responsibility.Ord1                          0.41801298
## extraversion_Assertiveness.Ord1                                0.42602702
## extraversion_Energy.Level.Ord1                                 0.38957794
## extraversion_Sociability.Ord1                                  0.14348818
## neuroticism_Anxiety.Ord1                                       0.06643272
## neuroticism_Depression.Ord1                                   -0.18675038
## neuroticism_Emotional.Volatility.Ord1                         -0.37696342
## openness_Aesthetic.Sensitivity.Ord1                            1.00000000
## openness_Creative.Imagination.Ord1                             0.13541568
## openness_Intellectual.Curiosity.Ord1                           0.28415241
##                                       openness_Creative.Imagination.Ord1
## agreeableness_Compassion.Ord1                                 0.37458034
## agreeableness_Respectfulness.Ord1                            -0.17862193
## agreeableness_Trust.Ord1                                      0.46349414
## conscientiousness_Organization.Ord1                           0.14865374
## conscientiousness_Productiveness.Ord1                         0.02839038
## conscientiousness_Responsibility.Ord1                        -0.21722840
## extraversion_Assertiveness.Ord1                               0.18766602
## extraversion_Energy.Level.Ord1                                0.10358889
## extraversion_Sociability.Ord1                                 0.14793908
## neuroticism_Anxiety.Ord1                                      0.24200955
## neuroticism_Depression.Ord1                                  -0.06386812
## neuroticism_Emotional.Volatility.Ord1                        -0.15339317
## openness_Aesthetic.Sensitivity.Ord1                           0.13541568
## openness_Creative.Imagination.Ord1                            1.00000000
## openness_Intellectual.Curiosity.Ord1                         -0.03077718
##                                       openness_Intellectual.Curiosity.Ord1
## agreeableness_Compassion.Ord1                                   0.09744585
## agreeableness_Respectfulness.Ord1                               0.54388484
## agreeableness_Trust.Ord1                                       -0.01800785
## conscientiousness_Organization.Ord1                             0.01530440
## conscientiousness_Productiveness.Ord1                           0.27137884
## conscientiousness_Responsibility.Ord1                           0.68352130
## extraversion_Assertiveness.Ord1                                 0.12597299
## extraversion_Energy.Level.Ord1                                 -0.00652038
## extraversion_Sociability.Ord1                                  -0.14786865
## neuroticism_Anxiety.Ord1                                        0.14892668
## neuroticism_Depression.Ord1                                     0.10632541
## neuroticism_Emotional.Volatility.Ord1                           0.06495692
## openness_Aesthetic.Sensitivity.Ord1                             0.28415241
## openness_Creative.Imagination.Ord1                             -0.03077718
## openness_Intellectual.Curiosity.Ord1                            1.00000000
ega_ind$dynEGA$ID143$mu
## NULL
ega_ind$dynEGA$ID143$lambda
## [1] 0.1
ega_ind$dynEGA$ID143$dim.variables

5.4 Plot the Results

Let’s plot it, shall we? To do this, we’ll use the qgraph package and my own stylistic preferences.

# now let's wrangle the names of the labels 
tnames <- tibble(old = rownames(ega_ind$dynEGA$ID143$network)
       , new = paste0(rep(c("A", "C", "E", "N", "O"), each = 1), rep(1:3, times = 5))) 
wmat <- ega_ind$dynEGA$ID143$network
colnames(wmat) <- tnames$new; rownames(wmat) <- tnames$new

# first, we need to make a list of the cluster membership
tmp <- ega_ind$dynEGA$ID143$dim.variables %>% 
  mutate(items = mapvalues(items, tnames$old, tnames$new)) %>%
  group_by(dimension) %>% 
  nest() %>% 
  ungroup()
mem_list <- tmp$data; names(mem_list) <- tmp$dimension
cols <- RColorBrewer::brewer.pal(length(mem_list), "Set3")

g <- qgraph(
  wmat
  , color = cols # color based on cluster
  , layout = "spring" # force directed algorithm
  , border.width = 4 # width of the border around nodes
  , vsize = 10 # size of the nodes
  , label.font = 2 # make the font bold
  , label.fill.vertical = 1 # make sure we use all our space for labels
  , negDashed = T # dash negative edges
  , edge.color = "black" # make edges black 
  , edge.labels = T # label the edges
)
plot(g)
title("ID143")

We can also make this a more flexible function and do it for everyone!

tnames <- tibble(old = rownames(ega_ind$dynEGA$ID143$network)
       , new = paste0(rep(c("A", "C", "E", "N", "O"), each = 1), rep(1:3, times = 5))) 

ega_qgraph_fun <- function(obj, id){
  # now let's wrangle the names of the labels 
  wmat <- obj$network
  colnames(wmat) <- tnames$new; rownames(wmat) <- tnames$new
  
  # first, we need to make a list of the cluster membership
  tmp <- obj$dim.variables %>% 
    mutate(items = mapvalues(items, tnames$old, tnames$new)) %>%
    group_by(dimension) %>% 
    nest() %>% 
    ungroup()
  mem_list <- tmp$data; names(mem_list) <- tmp$dimension
  cols <- RColorBrewer::brewer.pal(9, "Set3")[1:length(mem_list)]
  
  g <- qgraph(
    wmat
    , color = cols # color based on cluster
    , layout = "spring" # force directed algorithm
    , border.width = 4 # width of the border around nodes
    , vsize = 10 # size of the nodes
    , label.font = 2 # make the font bold
    , label.fill.vertical = 1 # make sure we use all our space for labels
    , negDashed = T # dash negative edges
    , edge.color = "black" # make edges black 
    , edge.labels = T # label the edges
    , mar = c(4,4,5,4) # margins
  )
  title(id, line = 3)
}

par(mfrow = c(3,4))
tibble(
  SID = names(ega_ind$dynEGA)
  , network = ega_ind$dynEGA
  ) %>%
  mutate(plot = map2(network, SID, ega_qgraph_fun))

6 Exercise 5: Variance Decomposition with MLM

dat3 <- read_csv(url(sprintf("%s/ESM-structure/blob/main/02-data/02-facet-wide/02-imputed/facet_wide_imp.csv?raw=true", wd))) %>%
  group_by(SID) %>%
  mutate_at(vars(-Full_Date, -all_beeps), lst(lag = lag)) %>%
  ungroup()
## Rows: 23615 Columns: 18
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (2): SID, Full_Date
## dbl (16): agreeableness_Compassion, agreeableness_Respectfulness, agreeablen...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

6.1 Unconditional Model

Level 1:
\(Y_{it} = \beta_{0i} + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} + u_{0i}\)

, where \(\beta_{0i}\) is the average value of \(Y\) for person \(i\) across all observations \(t\), \(\mu_{00}\) is the average value of \(Y\) across the full sample, and \(u_{0i}\) is the deviation from the average value of the sample for person \(i\) across all time points \(t\).

And the \(\tau\) matrix is summarized by a single cell, \(\tau_{00}^2\) and \(\sigma^2\) is the squared residuals, \(\epsilon_{it}\).

# run the model 
mod0 <- lmer(agreeableness_Compassion ~ 1 + (1 | SID), data = dat3)
# get model term summaries
tidy(mod0, conf.int = T)
# examine the Variance-Covariance matrix  
VarCorr(mod0)
##  Groups   Name        Std.Dev.
##  SID      (Intercept) 0.24582 
##  Residual             0.80169
# Groups = SID = tau^2
# Residual = sigma^2

6.1.1 ICC

The intraclass correlation captures the ratio of level 2 units (in this case person-means) to the total variance both across people and within each person:

\(\frac{\tau_{00}^2}{\tau_{00}^2 + \sigma^2}\)

vc <- VarCorr(mod0) %>% as.data.frame(); vc
icc <- vc$vcov[1] / (vc$vcov[1] + vc$vcov[2]); icc
## [1] 0.08594182

6.1.2 Distributions

My hot take is that MLM’s should never be run without including either all estimates of level 2 units or a distribution of all of those estimates. We’ll do the latter here.

coef(mod0)$SID %>%
  ggplot(aes(x = `(Intercept)`)) + 
  geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") + 
  geom_density(color = "blue", size = 1) + 
  labs(x = "Agreeableness: Compassion Person-Mean"
       , y = "Density"
       , title = "Distribution of Level 2 Units") + 
  theme_classic() + 
  theme(plot.title = element_text(hjust = .5, face = "bold"))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

6.2 Conditional Model

Conditional model just means that we are adjusting the variance decomposition by adding some covariate to the model. In this case, let’s look at autoregresion, or using previous time point \(y\) to predict next time point \(y\).
Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*X_{it} + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} + u_{0i}\)
\(\beta_{0i} = \mu_{10} + u_{1i}\)

, where:

  • \(\beta_{0i}\) is the average value of \(Y\) for person \(i\) across all observations \(t\)
  • \(\beta_{1i}\) is the autoregressive relationship of \(Y\) for person \(i\) across all observations \(t\)
  • \(\mu_{00}\) is the average value of \(Y\) across the full sample
  • \(\mu_{10}\) is the average autoregressive relationship of \(Y\) across the full sample
  • \(u_{0i}\) is the deviation from the average value of the sample for person \(i\) across all time points \(t\).
  • \(u_{1i}\) is the deviation from the average autoregressive relationship for person \(i\) across all time points \(t\).
mod1 <- lmer(agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag + ( 1 + agreeableness_Compassion_lag | SID)
             , data = dat3); mod1
## Linear mixed model fit by REML ['lmerMod']
## Formula: agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag +  
##     (1 + agreeableness_Compassion_lag | SID)
##    Data: dat3
## REML criterion at convergence: 12509.97
## Random effects:
##  Groups   Name                         Std.Dev. Corr 
##  SID      (Intercept)                  0.29114       
##           agreeableness_Compassion_lag 0.06579  -0.60
##  Residual                              0.80034       
## Number of obs: 5126, groups:  SID, 188
## Fixed Effects:
##                  (Intercept)  agreeableness_Compassion_lag  
##                      3.35972                       0.05038
td1 <- tidy(mod1, conf.int = T); td1

There was a small carry-over association between previous and current time point compassion (\(\mu_{10}\) = 0.05, 95% CI = [0.02, 0.08]).

6.2.1 Distributions

Here, we need to plot two random effects, the average level and teh average lagged association.

coef(mod1)$SID %>% 
  rownames_to_column("id") %>%
  pivot_longer(
    cols = -id
    , names_to = "term"
    , values_to = "est"
  ) %>%
  mutate(term = mapvalues(term, c("(Intercept)", "agreeableness_Compassion_lag"), c("Person-Mean Compassion", "Person-Specific Lagged Association"))) %>%
  ggplot(aes(x = est)) + 
  geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") + 
  geom_density(color = "blue", size = 1) + 
  facet_grid(~term, scales = "free") + 
  labs(x = "Empirical Bayes Estimate"
       , y = "Density"
       , title = "Distribution of Level 2 Units") + 
  theme_classic() + 
  theme(plot.title = element_text(hjust = .5, face = "bold"))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

6.3 Add Time-Varying Covariate / Predictor

Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*y_{it-1} + \beta_{2i}*X_{it} + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} + u_{0i}\)
\(\beta_{1i} = \mu_{10} + u_{1i}\)
\(\beta_{2i} = \mu_{20} + u_{1i}\)

, where:

  • \(\mu_{00}\) = average level of \(Y\) across people \(i\) and time points \(t\).
  • \(\mu_{10}\) is the average autoregressive relationship of \(Y\) across the full sample.
  • \(\mu_{20}\) = average association between \(X\) and \(Y\) across the full sample.
  • \(\beta_{0i}\) = average levels of \(Y\) for person \(i\).
  • \(\beta_{1i}\) is the autoregressive relationship of \(Y\) for person \(i\) across all observations \(t\).
  • \(\beta_{2i}\) = average assocation between \(X\) and \(Y\) for person \(i\) across time points \(t\).
  • \(u_{0i}\) = deviations from average levels of \(Y\) for person \(i\).
  • \(u_{1i}\) is the deviation from the average autoregressive relationship for person \(i\) across all time points \(t\).
  • \(u_{2i}\) is the deviation from the average \(XY\) association for person \(i\) across all time points \(t\).
mod2 <- lmer(agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag  + extraversion_Sociability +
               ( 1 + agreeableness_Compassion_lag + extraversion_Sociability | SID)
             , data = dat3); mod2
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00955907 (tol = 0.002, component 1)
## Linear mixed model fit by REML ['lmerMod']
## Formula: agreeableness_Compassion ~ 1 + agreeableness_Compassion_lag +  
##     extraversion_Sociability + (1 + agreeableness_Compassion_lag +  
##     extraversion_Sociability | SID)
##    Data: dat3
## REML criterion at convergence: 12365.16
## Random effects:
##  Groups   Name                         Std.Dev. Corr       
##  SID      (Intercept)                  0.14730             
##           agreeableness_Compassion_lag 0.06595  -0.69      
##           extraversion_Sociability     0.03845   0.99 -0.59
##  Residual                              0.78993             
## Number of obs: 5126, groups:  SID, 188
## Fixed Effects:
##                  (Intercept)  agreeableness_Compassion_lag  
##                      2.97919                       0.04667  
##     extraversion_Sociability  
##                      0.12424  
## optimizer (nloptwrap) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings
td2 <- tidy(mod2, conf.int = T); td2

There was a concurrent association between sociability and compassion, even when accounting for previous compassion (\(\mu_{20}\) = 0.12, 95% CI [0.10, 0.15]). Moreover, even when accounting for concurrent sociability, the carry-over association of compassion remained ($_{10} = 0.05, 95% CI [0.02, 0.08]).

6.3.1 Distributions

Here, we need to plot three random effects, the average level, the average lagged association, the sociability-compassion association.

coef(mod2)$SID %>% 
  rownames_to_column("id") %>%
  pivot_longer(
    cols = -id
    , names_to = "term"
    , values_to = "est"
  ) %>%
  mutate(term = mapvalues(term, c("(Intercept)", "agreeableness_Compassion_lag", "extraversion_Sociability")
                   , c("Person-Mean Compassion", "Person-Specific Lagged Association", "Person-Specific\n Sociability-Compassion Association"))) %>%
  ggplot(aes(x = est)) + 
  geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") + 
  geom_density(color = "blue", size = 1) + 
  facet_grid(~term, scales = "free") + 
  labs(x = "Empirical Bayes Estimate"
       , y = "Density"
       , title = "Distribution of Level 2 Units") + 
  theme_classic() + 
  theme(plot.title = element_text(hjust = .5, face = "bold"))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

6.4 Add Time-Invariant Covariate / Predictor

Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*(X_{it}-\bar{X}_{i}) + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} + \mu_{01}*(\bar{X}_{i} - \bar{X}) + u_{0i}\)
\(\beta_{1i} = \mu_{10} + \mu_{11}*(\bar{X}_{i} - \bar{X}) + u_{1i}\)

, where:

  • \(\mu_{10}\) = average change in \(Y\) as a function of deviations from within-person averages of \(X\) across people \(i\) and time points \(t\).
  • \(\mu_{01}\) = average change in \(Y\) as a function of between person differences in average levels of \(X\) across people \(i\) and time points \(t\).
  • \(\mu_{11}\) = average change in \(Y\) as a function of both within-person deviations from person-level means and between-person differences average levels of \(X\) across people \(i\) and time points \(t\).
  • \(\beta_{0i}\) = average levels of \(Y\) for person \(i\) across time points \(t\).
  • \(\beta_{1i}\) = average change in \(Y\) as a function of within-person deviations in \(X\) for person \(i\) across time points \(t\).
  • \(u_{0i}\) = deviations from average levels of \(Y\) for person \(i\) across time points \(t\).
  • \(u_{1i}\) = deviations in change in \(Y\) as a function of deviations in within-person levels of \(X\) for person \(i\) across time points \(t\).
dat3a <- dat3 %>% 
  # keep only necessary variables
  select(SID, all_beeps, agreeableness_Compassion, agreeableness_Compassion_lag, extraversion_Sociability, all_beeps) %>%
  # group by person to get person-specific means
  group_by(SID) %>%
  # person-mean centered sociability -- used in model
  mutate(extraversion_Sociability_c = extraversion_Sociability - mean(extraversion_Sociability, na.rm = T)
  # person average sociability -- not used in model
         , extraversion_Sociability_m = mean(extraversion_Sociability, na.rm = T)) %>%
  ungroup() %>%
  # grand mean centered person means -- used in model
  mutate(extraversion_Sociability_gmc = extraversion_Sociability_m - mean(extraversion_Sociability_m))

# run the model
mod3 <- lmer(agreeableness_Compassion ~ 1 + extraversion_Sociability_c + extraversion_Sociability_gmc + extraversion_Sociability_c:extraversion_Sociability_gmc + 
               (1 + extraversion_Sociability_c | SID), data = dat3a); mod3
## Linear mixed model fit by REML ['lmerMod']
## Formula: 
## agreeableness_Compassion ~ 1 + extraversion_Sociability_c + extraversion_Sociability_gmc +  
##     extraversion_Sociability_c:extraversion_Sociability_gmc +  
##     (1 + extraversion_Sociability_c | SID)
##    Data: dat3a
## REML criterion at convergence: 20825.05
## Random effects:
##  Groups   Name                       Std.Dev. Corr
##  SID      (Intercept)                0.20193      
##           extraversion_Sociability_c 0.02567  0.44
##  Residual                            0.79106      
## Number of obs: 8673, groups:  SID, 199
## Fixed Effects:
##                                             (Intercept)  
##                                                 3.50554  
##                              extraversion_Sociability_c  
##                                                 0.11146  
##                            extraversion_Sociability_gmc  
##                                                 0.36405  
## extraversion_Sociability_c:extraversion_Sociability_gmc  
##                                                 0.06265
td3 <- tidy(mod3, conf.int = T); td3

Higher sociability than usual for an individual is associated with more compassion, on average (\(\mu_{10}\) = 0.11, 95% CI [0.10, 0.13]). People with higher sociability, on average, were also more compassionate (\(\mu_{01}\) = 0.36, 95% CI [0.28, 0.45]). Finally, there was interaction between average sociability and deviations of sociability (\(\mu_{11}\) = 0.06, 95% CI [0.02, 0.10]), such that for individuals who were higher in sociability than others, they were even more compassionate when they were more sociable than usual relative to individuals lower in sociability than others.

6.4.1 Distributions

Here, we need to plot two random effects, the average level and the association between deviations from person-means in sociability and deviations in compassion.

coef(mod3)$SID %>% 
  rownames_to_column("id") %>%
  select(-extraversion_Sociability_gmc, -`extraversion_Sociability_c:extraversion_Sociability_gmc`) %>%
  pivot_longer(
    cols = -id
    , names_to = "term"
    , values_to = "est"
  ) %>%
  mutate(term = mapvalues(term, c("(Intercept)", "extraversion_Sociability_c"), c("Person-Mean Compassion", "Person-Specific Sociability-Compassion Association"))) %>%
  ggplot(aes(x = est)) + 
  geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") + 
  geom_density(color = "blue", size = 1) + 
  facet_grid(~term, scales = "free") + 
  labs(x = "Empirical Bayes Estimate"
       , y = "Density"
       , title = "Distribution of Level 2 Units") + 
  theme_classic() + 
  theme(plot.title = element_text(hjust = .5, face = "bold"))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

6.5 Growth Models

6.5.1 Data

These data come from the National Longitudinal Studies of Youth, Children and Young Adults Sample and were used in Bollich, Beck, Hill, and Jackson (2021) to estimate trajectories of four individual difference characteristics depending on whether adolescents had contact with the criminal justice system or not.

load(url("https://github.com/emoriebeck/R-tutorials/blob/master/11-ggplot-p3-mlm/data/sample.RData?raw=true"))
sample_dat

At its simplest, a growth model is just a basic MLM with a time-varying covariate (where the time-varying covariate is itself time).
Level 1:
\(Y_{it} = \beta_{0i} + \beta_{1i}*time_{it} + \epsilon_{it}\)
Level 2:
\(\beta_{0i} = \mu_{00} + u_{0i}\)
\(\beta_{1i} = \mu_{10} + u_{1i}\)

, where:

  • \(\mu_{10}\) = average change in \(Y\) as a function of deviations from within-person averages of \(X\) across people \(i\) and time points \(t\).
  • \(\beta_{0i}\) = average levels of \(Y\) for person \(i\) at time 0.
  • \(\beta_{1i}\) = average slope / change in \(Y\) for person \(i\) across time points \(t\).
  • \(u_{0i}\) = deviations from average levels of \(Y\) at wave 0 for person \(i\).
  • \(u_{1i}\) = deviations in slope / change in \(Y\) for person \(i\) across time points \(t\).
mod4 <- lmer(CESD ~ 1 + age0 + ( 1 + age0 | PROC_CID), data = sample_dat); mod4
## Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
## Model failed to converge with max|grad| = 0.00354122 (tol = 0.002, component 1)
## Linear mixed model fit by REML ['lmerMod']
## Formula: CESD ~ 1 + age0 + (1 + age0 | PROC_CID)
##    Data: sample_dat
## REML criterion at convergence: 3436.366
## Random effects:
##  Groups   Name        Std.Dev. Corr 
##  PROC_CID (Intercept) 0.35986       
##           age0        0.04852  -0.50
##  Residual             0.45018       
## Number of obs: 2084, groups:  PROC_CID, 924
## Fixed Effects:
## (Intercept)         age0  
##    0.702309     0.007357  
## optimizer (nloptwrap) convergence code: 0 (OK) ; 0 optimizer warnings; 1 lme4 warnings
td4 <- tidy(mod4, conf.int = T); td4

Overall, there was no significant change in Sensation Seeking across adolescence (\(\mu_{10}\) = 0.007, 95% CI [-0.0003, 0.02]).

6.5.2 Distributions

Here, we need to plot two random effects, the average level at age 14 and the slope.

coef(mod4)$PROC_CID %>% 
  rownames_to_column("id") %>%
  pivot_longer(
    cols = -id
    , names_to = "term"
    , values_to = "est"
  ) %>%
  mutate(term = mapvalues(term, c("(Intercept)", "age0")
                   , c("CESD at Age 14", "Person-Specific Slope"))) %>%
  ggplot(aes(x = est)) + 
  geom_histogram(aes(y = ..density..), fill = "lightgrey", color = "black") + 
  geom_density(color = "blue", size = 1) + 
  facet_grid(~term, scales = "free") + 
  labs(x = "Empirical Bayes Estimate"
       , y = "Density"
       , title = "Distribution of Level 2 Units") + 
  theme_classic() + 
  theme(plot.title = element_text(hjust = .5, face = "bold"))
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

6.6 Mega-Analysis

At its most basic form, a mega-analysis is just a basic multilevel model with a Level 1 covariate. The difference is that it’s no longer observations across time nested within people. Instead its people nested within samples with samples as the grouping variable.

Level 1:
\(Y_{is} = \beta_{0s} + \beta_{2s}*X_{is} + \epsilon_{is}\)
Level 2:
\(\beta_{0i} = \gamma_{00} + u_{0i}\)
\(\beta_{1s} = \gamma_{10} + u_{1s}\)

, where:

  • \(\gamma_{00}\) = average level of \(Y\) across people \(i\) and samples \(t\).
  • \(\gamma_{10}\) = average association between \(X\) and \(Y\) across all samples (the “mega-analytic” association).
  • \(\beta_{0s}\) = average levels of \(Y\) for sample \(s\).
  • \(\beta_{1s}\) = average association between \(X\) and \(Y\) for sample \(s\) across people \(i\).
  • \(u_{0s}\) = deviations from average levels of \(Y\) for sample \(s\).
  • \(u_{1s}\) is the deviation from the average \(XY\) association for sample \(s\) across all people \(i\).

6.6.1 Data

These data come from a yet-unpublished project examining 8 methods for synthesizing data via individual-participants meta-analysis, including meta-analysis. The data come from many samples, but all information on those samples has been scrubbed from the data we’ll be using and it will only be a relatively small sub-sample of the population (500 from each sample). Specifically, this data set examines the association bewteen Conscientiousness and episodic memory across 10 samples.

load(url("https://github.com/emoriebeck/R-tutorials/blob/master/99_archive/sample-mega-analysis.RData?raw=true"))
d
mod5 <- lmer(o_value ~ 1 + p_value + ( 1 + p_value | study), data = d); mod5
## Linear mixed model fit by REML ['lmerMod']
## Formula: o_value ~ 1 + p_value + (1 + p_value | study)
##    Data: d
## REML criterion at convergence: 21623.18
## Random effects:
##  Groups   Name        Std.Dev. Corr 
##  study    (Intercept) 2.119         
##           p_value     0.120    -0.68
##  Residual             2.087         
## Number of obs: 5000, groups:  study, 10
## Fixed Effects:
## (Intercept)      p_value  
##      5.1446       0.1014
td5 <- tidy(mod5, conf.int = T); td5

Overall, there was a significant association between Conscientiousness and Episodic Memory across samples (\(\gammau_{10}\) = 0.10, 95% CI [0.02, 0.18]).

6.6.2 Distributions

Rather than distributions, we are going to look at forest plots of the intercepts and personality-outcome associations because this is more typical in meta/mega-analysis.

fp_dat <- coef(mod5)$study %>%
      data.frame() %>%
      rownames_to_column("study") %>%
      mutate(term = "estimate") %>%
      full_join(
        parameters::standard_error(mod5, effects = "random")$study %>%
          data.frame() %>%
          rownames_to_column("study") %>%
          mutate(term = "SE")) %>%
      rename(Intercept = X.Intercept.) %>%
      # select(study, term, , p_value) %>%
      pivot_longer(c(-study, -term), names_to = "names", values_to = "estimate") %>%
      pivot_wider(names_from = "term", values_from = "estimate") %>% 
      rename(term = names) %>%
      mutate(conf.low = estimate - 2*SE, conf.high = estimate + 2*SE,
             term = ifelse(grepl("p_value.", term), str_replace_all(term, "p_value.", "p_value:"), term)) %>%
  full_join(
    td5 %>% 
      filter(effect == "fixed") %>% 
      select(term, estimate, conf.low, conf.high) %>% 
      mutate(study = "Overall", term = str_replace(term, "\\(Intercept\\)", "Intercept"))
  )
## Joining, by = c("study", "X.Intercept.", "p_value", "term")
## Joining, by = c("study", "term", "estimate", "conf.low", "conf.high")
## arrange by effect size
std_levs <- (fp_dat %>% 
  filter(study != "Overall" & term == "p_value") %>%
  arrange(estimate))$study

fp_dat %>%
  filter(term == "p_value") %>%
  mutate(study = factor(study, c("Overall", std_levs))) %>%
  ggplot(aes(x = study, y = estimate)) + 
  geom_errorbar(aes(ymin = conf.low, ymax = conf.high)
             , position = "dodge"
             , width = .1) + 
  geom_hline(aes(yintercept = 0), linetype = "dashed", size = .7) +
  geom_point() + 
  coord_flip() +
  theme_classic() 

Honestly, this isn’t a super-satisfactory forest plot, but much better examples can be found at https://github.com/emoriebeck/data-synthesis-tutorial and seen on https://emoriebeck.shinyapps.io/data-synthesis-tutorial.

7 Miscellaneous

7.1 Fake Data for EGA Slides

id <- rep(1, 16)
x1 <- c(3, 2, 3, 3, 2, 5, 4, 5, 2, 4, 4, 3, 4, 2, 2, 4)
x2 <- c(3, 2, 1, 4, 3, 4, 3, 2, 3, 2, 3, 2, 4, 2, 1, 3)
x3 <- c(4, 1, 1, 4, 3, 1, 2, 4, 3, 3, 2, 3, 1, 2, 1, 0)
x4 <- c(3, 4, 3, 3, 3, 4, 1, 4, 2, 1, 4, 2, 4, 4, 2, 4)
x5 <- c(3, 2, 4, 3, 3, 1, 2, 3, 3, 3, 0, 2, 4, 3, 2, 4)
x <- cbind(x1, x2, x3, x4, x5)

r <- round(apply(x, 2, function(i) glla(i, n.embed = 5, tau = 1, delta = 4, order = 1)[,2]), 2)
g <- qgraph(cor_auto(r)
            , layout = "spring"
            , graph = "glasso"
            , sampleSize = 100
            , color = c("#302ef9", "#ec7d32", "#ffbf00", "#00b050", "#70309f")
            , vsize = 15
            , border.width = 4
            # , labels = c("x_1*", "delta x1*", "delta x1*", "delta x1*", "delta x1*")
            , label.color = "white"
            , label.font = 2
            , label.fill.vertical = 1
            , edge.color = "black")

g$graphAttributes$Edges$lty[g$Edgelist$weight < 0] <- 2
# png(filename = "~/Downloads/plot.png", width = 1000, height = 1000)
plot(g)

# dev.off()
pr <- getWmat(g)

x <- as.data.frame(cbind(id, x1, x2, x3, x4, x5))
dx <- dynEGA(x, n.embed = 5, level = "individual", model = "glasso", id = 1, delta = 4, order = 1)
## 
## Computing derivatives using GLLA...
## Estimating the dimensionality structure using EGA...
## Level: Individual (Intraindividual Structure)...
## done